home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload Trio 2 / Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO / dir42 / fpw2xl.zip / NEWGRAPH.PRG next >
Text File  |  1993-06-23  |  9KB  |  329 lines
  1. PROCEDURE newgraph
  2.    PARAMETER lv_sid
  3.    *
  4.    *
  5.    *
  6.    CLOSE DATA
  7.    USE patients ORDER name
  8.    *
  9.    CLEAR
  10.    *
  11.    SELE patients
  12.    IF TYPE('lv_sid') <> "N"
  13.       @ 5,5 SAY "Class (P|C|E):" GET m.class DEFAULT "P"
  14.       READ
  15.       *
  16.       SET TALK OFF
  17.       COUNT FOR CLASS=m.class TO lv_records
  18.       SET TALK ON
  19.       DIMENSION la_pat (lv_records,3)
  20.       COPY TO ARRAY la_pat FIELDS name,sid,scandate FOR CLASS=m.class
  21.       
  22.       for i = 1 to lv_records
  23.         la_pat(i,1)=la_pat(i,1)+dtoc(la_pat(i,3))
  24.       endfor
  25.       
  26.       lv_patidx=0
  27.       DEFI WIND pickpat AT 7,5 SIZE 11,60 font "Courier New",10
  28.       ACTI WIND pickpat
  29.       @ 0,0 GET lv_patidx FROM la_pat FUNCTION "&T"
  30.       READ
  31.       RELE WIND pickpat
  32.       *
  33.       @ 7,5 SAY la_pat(lv_patidx,1)
  34.       lv_sid=la_pat(lv_patidx,2)
  35.       RELE la_pat,lv_patidx, lv_records
  36.    ENDIF
  37.    *
  38.    LOCATE FOR sid=lv_sid
  39.    ls_header = ALLTRIM(name)
  40.    ls_header = IIF(EMPTY(dob),     ls_header,ls_header+" dob "+DTOC(dob))
  41.    ls_header = IIF(EMPTY(scandate),ls_header,ls_header+" on "+DTOC(scandate))
  42.    ls_header = IIF(EMPTY(op),      ls_header,ls_header+PROPER(op)+"-op.")
  43.    USE
  44.    *
  45.    *
  46.    USE volumes
  47.    SET TALK OFF
  48.    CALCULATE MAX(pos) TO lv_lastpos
  49.    SET TALK ON
  50.    *
  51.    lv_slices = (lv_lastpos/1.5)+1
  52.    RELE lv_lastpos
  53.    DIMENSION la_volumes (lv_slices,4)
  54.    LOCATE FOR volumes.sid=lv_sid
  55.    IF NOT FOUND()
  56.       ? "Hopelessly buggered data"
  57.       RETURN
  58.    ENDIF
  59.    *
  60.    lv_posmm = 0
  61.    FOR i = 1 TO lv_slices
  62.       IF FOUND()
  63.          IF volumes.pos=lv_posmm
  64.             la_volumes(i,1)=IIF(volumes.lhvol>0,ALLTRIM(STR(lhvol,8,2)),'')
  65.             la_volumes(i,2)=IIF(volumes.rhvol>0,ALLTRIM(STR(rhvol,8,2)),'')
  66.             la_volumes(i,3)=IIF(volumes.lavol>0,ALLTRIM(STR(lavol,8,2)),'')
  67.             la_volumes(i,4)=IIF(volumes.ravol>0,ALLTRIM(STR(ravol,8,2)),'')
  68.          ENDIF
  69.          CONTINUE
  70.       ELSE
  71.          la_volumes(i,1)=''
  72.          la_volumes(i,2)=''
  73.          la_volumes(i,3)=''
  74.          la_volumes(i,4)=''
  75.       ENDIF
  76.       *
  77.       lv_posmm = lv_posmm +1.5
  78.    ENDFOR
  79.    *
  80.    *  now data is in array la_volumes and ls_header
  81.    *
  82.    CLOSE DATA
  83.    *
  84.    *  Now the really fancy stuff...
  85.    *
  86.    xlsystem = -1
  87.    xlsheet1 = -1
  88.    *
  89.    =ddesetoption('SAFETY',.F.)
  90.    =ddesetoption('TIMEOUT',2000)
  91.    *
  92.    xlsystem = DDEINITIATE('Excel','System')
  93.    IF xlsystem <0
  94.       ! /n2 C:\excel\excel
  95.       tries = 10
  96.       DO WHILE (tries >0) AND (xlsystem <0)
  97.          WAIT WINDOW "Waiting for"+CHR(13)+"EXCEL to initialise" TIMEOUT 2
  98.          tries = tries-1
  99.          xlsystem = DDEINITIATE('Excel','System')
  100.       ENDDO
  101.       IF tries =0
  102.          DO abend WITH "Excel not responding"
  103.       ENDIF
  104.    ENDIF
  105.    xlsheet1 = DDEINITIATE('Excel','Sheet1')
  106.    tries = 10
  107.    DO WHILE (tries >0) AND (xlsheet1 <0)
  108.       WAIT WINDOW "Waiting for"+CHR(13)+"EXCEL - Sheet1" TIMEOUT 2
  109.       tries = tries-1
  110.       xlsheet1 = DDEINITIATE('Excel','Sheet1')
  111.    ENDDO
  112.    IF tries =0
  113.       DO abend WITH "Sheet1 not responding"
  114.    ENDIF
  115.    *
  116.    *  Now we have the DDE channels open
  117.    *
  118.    xlrow=1
  119.    lv_posmm=0
  120.    FOR xlcol =2 TO lv_slices+1
  121.       =rcpoke(ALLTRIM(STR(lv_posmm,8,2)))
  122.       lv_posmm = lv_posmm +1.5
  123.    ENDFOR
  124.    *
  125.    xlrow=2
  126.    xlcol=1
  127.    =rcpoke('Left Hippocampal')
  128.    xlrow=3
  129.    xlcol=1
  130.    =rcpoke('Right Hippocampal')
  131.    xlrow=4
  132.    xlcol=1
  133.    =rcpoke('Left Amygdala')
  134.    xlrow=5
  135.    xlcol=1
  136.    =rcpoke('Right Amygdala')
  137.    *
  138.    FOR xlcol =2 TO lv_slices+1
  139.       xlrow =2
  140.       =rcpoke(la_volumes(xlcol-1,1))
  141.       xlrow =3
  142.       =rcpoke(la_volumes(xlcol-1,2))
  143.       xlrow =4
  144.       =rcpoke(la_volumes(xlcol-1,3))
  145.       xlrow =5
  146.       =rcpoke(la_volumes(xlcol-1,4))
  147.    ENDFOR
  148.    *
  149.    RELE la_volumes,lv_slices,lv_posmm
  150.    RELE xlrow,xlcol
  151.    *
  152.    * data complete, now graph it!
  153.    *
  154.    IF NOT DDEEXECUTE(xlsystem,'[select("R1:R5")]')
  155.       DO abend WITH '[select(!R1:R5)]'
  156.    ENDIF
  157.    IF NOT DDEEXECUTE(xlsystem,'[new(2)]')
  158.       DO abend WITH "new(2)"
  159.    ENDIF
  160.    IF NOT DDEEXECUTE(xlsystem,'[page.setup("","",.5,.5,.5,.5,3,TRUE,TRUE,2,9,100)]')
  161.       DO abend WITH '[page.setup("","",.5,.5,.5,.5,3,TRUE,TRUE,2,9,100)]'
  162.    ENDIF
  163.    *
  164.    IF NOT DDEEXECUTE(xlsystem,'[legend(TRUE)]')
  165.       DO abend WITH '[legend(TRUE)]'
  166.    ENDIF
  167.    IF NOT DDEEXECUTE(xlsystem,'[select("Legend")]')
  168.       DO abend WITH '[select("Legend")]'
  169.    ENDIF
  170.    IF NOT DDEEXECUTE(xlsystem,'[patterns(1,,,,FALSE,1,,,,FALSE)]')
  171.       DO abend WITH '[patterns(1,,,,FALSE,1,,,,FALSE)]'
  172.    ENDIF
  173.    IF NOT DDEEXECUTE(xlsystem,'[format.legend(2)]')
  174.       DO abend WITH '[format.legend(2)]'
  175.    ENDIF
  176.    IF NOT DDEEXECUTE(xlsystem,'[format.font(0,1,FALSE,"Arial",10,FALSE,FALSE,FALSE,FALSE)]')
  177.       DO abend WITH '[format.font(0,1,FALSE,"Arial",10,FALSE,FALSE,FALSE,FALSE)]'
  178.    ENDIF
  179.    *
  180.    IF NOT DDEEXECUTE(xlsystem,'[attach.text(1)]')
  181.       DO abend WITH '[attach.text(1)]'
  182.    ENDIF
  183.    IF NOT DDEEXECUTE(xlsystem,'[formula("=""'+ls_header+'""")]')
  184.       DO abend WITH '[formula("=""'+ls_header+'""")]'
  185.    ENDIF
  186.    IF NOT DDEEXECUTE(xlsystem,'[format.font(0,1,FALSE,"Arial",14,TRUE,FALSE,FALSE,FALSE)]')
  187.       DO abend WITH '[format.font(0,1,FALSE,"Arial",14,TRUE,FALSE,FALSE,FALSE)]'
  188.    ENDIF
  189.    *
  190.    IF NOT DDEEXECUTE(xlsystem,'[gallery.line(2,TRUE)]')
  191.       DO abend WITH '[gallery.line(2,TRUE)]'
  192.    ENDIF
  193.    IF NOT DDEEXECUTE(xlsystem,'[gridlines(FALSE,FALSE,FALSE,FALSE)]')
  194.       DO abend WITH '[gridlines(FALSE,FALSE,FALSE,FALSE)]'
  195.    ENDIF
  196.    *
  197.    IF NOT DDEEXECUTE(xlsystem,'[select("Axis 1")]')
  198.       DO abend WITH '[select("Axis 1")]'
  199.    ENDIF
  200.    IF NOT DDEEXECUTE(xlsystem,'[patterns(1,1,1,1,4,3,4)]')
  201.       DO abend WITH '[patterns(1,1,1,1,4,3,4)]'
  202.    ENDIF
  203.    IF NOT DDEEXECUTE(xlsystem,'[SCALE(0,350,50,10,TRUE,FALSE,FALSE,FALSE)]')
  204.       DO abend WITH '[SCALE(0,350,50,10,TRUE,FALSE,FALSE,FALSE)]'
  205.    ENDIF
  206.    IF NOT DDEEXECUTE(xlsystem,'[format.font(0,1,FALSE,"Arial",10,FALSE,FALSE,FALSE,FALSE)]')
  207.       DO abend WITH '[format.font(0,1,FALSE,"Arial",10,FALSE,FALSE,FALSE,FALSE)]'
  208.    ENDIF
  209.    *
  210.    IF NOT DDEEXECUTE(xlsystem,'[select("Axis 2")]')
  211.       DO abend WITH '[select("Axis 2")]'
  212.    ENDIF
  213.    IF NOT DDEEXECUTE(xlsystem,'[patterns(1,,,,4,1,4)]')
  214.       DO abend WITH '[patterns(1,,,,4,1,4)]'
  215.    ENDIF
  216.    IF NOT DDEEXECUTE(xlsystem,'[format.font(0,1,FALSE,"Arial",10,FALSE,FALSE,FALSE,FALSE)]')
  217.       DO abend WITH '[format.font(0,1,FALSE,"Arial",10,FALSE,FALSE,FALSE,FALSE)]'
  218.    ENDIF
  219.    *
  220.    IF NOT DDEEXECUTE(xlsystem,'[select("S1")]')
  221.       DO abend WITH '[select("S1")]'
  222.    ENDIF
  223.    IF NOT DDEEXECUTE(xlsystem,'[patterns(1,1,1,1,1,1,1,4,FALSE)]')
  224.       DO abend WITH '[patterns(1,1,1,1,1,1,1,4,FALSE)]'
  225.    ENDIF
  226.    *
  227.    IF NOT DDEEXECUTE(xlsystem,'[select("S2")]')
  228.       DO abend WITH '[select("S2")]'
  229.    ENDIF
  230.    IF NOT DDEEXECUTE(xlsystem,'[patterns(1,1,1,1,1,1,1,3,FALSE)]')
  231.       DO abend WITH '[patterns(1,1,1,1,1,1,1,3,FALSE)]'
  232.    ENDIF
  233.    *
  234.    * We don't care if S3 can't be found
  235.    IF DDEEXECUTE(xlsystem,'[select("S3")]')
  236.       IF NOT DDEEXECUTE(xlsystem,'[patterns(1,1,1,1,1,1,1,6,FALSE)]')
  237.          DO abend WITH '[patterns(1,1,1,1,1,1,1,6,FALSE)]'
  238.       ENDIF
  239.    ENDIF
  240.    *
  241.    * we don't care if S4 can't be found
  242.    IF DDEEXECUTE(xlsystem,'[select("S4")]')
  243.       IF NOT DDEEXECUTE(xlsystem,'[patterns(1,1,1,1,1,1,1,5,FALSE)]')
  244.          DO abend WITH '[patterns(1,1,1,1,1,1,1,5,FALSE)]'
  245.       ENDIF
  246.    ENDIF
  247.    *
  248.    * printing can take a while - allow 30 seconds!
  249.    *
  250.    =ddesetoption('TIMEOUT',30000)
  251.    IF NOT DDEEXECUTE(xlsystem,'[print(1,,,1,FALSE,FALSE,1)]')
  252.       DO abend WITH '[print(1,,,1,FALSE,FALSE,1)]'
  253.    ENDIF
  254.    *
  255.    * reset to 2 seconds
  256.    *
  257.    =ddesetoption('TIMEOUT',2000)
  258.    IF NOT DDEEXECUTE(xlsystem,'[close(FALSE)]')
  259.       DO abend WITH '[close(FALSE)] - Graph'
  260.    ENDIF
  261.    *
  262.    * Close DDE conversation
  263.    *
  264.    IF NOT DDETERMINATE(xlsheet1)
  265.       DO abend WITH "Could not Terminate Sheet1"
  266.    ENDIF
  267.    xlsheet1 = -1
  268.    *
  269.    *
  270.    IF NOT DDEEXECUTE(xlsystem,'[close(FALSE)]')
  271.       DO abend WITH '[close(FALSE)] - Sheet'
  272.    ENDIF
  273.    *
  274.    * Close Excel
  275.    *
  276.    =DDEEXECUTE(xlsystem,'[Quit]')
  277.    *
  278.    * We can ignore the error from this, because we shut down Excel with the
  279.    *  previous command...
  280.    *
  281.    =DDETERMINATE(xlsystem)
  282.    xlsystem = -1
  283.    *
  284.    *
  285.    *
  286.    DO abend
  287.    RETURN
  288.  
  289. FUNCTION rc
  290.    PARAMETERS arow,acol
  291.    RETURN 'R'+ALLTRIM(STR(arow))+'C'+ALLTRIM(STR(acol))
  292.  
  293. FUNCTION mmmyy
  294.    PARAMETER monthindex
  295.    yi=0
  296.    mi=monthindex%12
  297.    yi=INT(monthindex/12)
  298.    yi=IIF(mi=0,yi-1,yi)
  299.    mi=IIF(mi=0,12,mi)
  300.    RETURN LEFT(CMONTH(CTOD('1/'+STR(mi)+'/90')),3)+'-'+ALLTRIM(STR(yi+90))
  301.  
  302. PROCEDURE rcpoke
  303.    PARAMETERS astring
  304.    IF NOT DDEPOKE(xlsheet1,rc(xlrow,xlcol),astring)
  305.       DO abend WITH "Poke @"+rc(xlrow,xlcol)+" "+astring
  306.    ENDIF
  307.    RETURN
  308.  
  309. PROCEDURE abend
  310.    PARAMETERS amessage
  311.    IF TYPE('amessage') = 'C'
  312.       WAIT WINDOW "DDE Error"+CHR(13)+amessage
  313.    ENDIF
  314.    CLOSE DATA
  315.    CLEAR
  316.    IF TYPE('amessage') = 'C'
  317.       IF xlsheet1 # -1
  318.          =DDEEXECUTE(xlsystem,'[close(FALSE)]')
  319.          =DDETERMINATE(xlsheet1)
  320.       ENDIF
  321.       IF xlsystem # -1
  322.          =DDEEXECUTE(xlsystem,'[close(FALSE)]')
  323.          =DDEEXECUTE(xlsystem,'[Quit]')
  324.          =DDETERMINATE(xlsystem)
  325.       ENDIF
  326.       RETURN TO MASTER
  327.    ENDIF
  328.    RETURN
  329.